perm filename QUICK.PAS[1,ALS] blob
sn#387805 filedate 1978-10-16 generic text, type T, neo UTF8
PROGRAM QUICKSORT(OUTPUT);
(**********************************************************************)
CONST
MAXSORT= 8000;
MAXINDX= 8001;
MAXSTACK= 200;
M= 9;
INFINITY= 2147483647;
TYPE
SORTINDX= 0 .. MAXINDX;
SORTITEM= INTEGER;
SORTARY= ARRAY [SORTINDX] OF SORTITEM;
VAR
A: SORTARY;
(**********************************************************************)
PROCEDURE WRTINT(I,LEN: INTEGER);
VAR
POW10: INTEGER;
NEG: BOOLEAN;
DIGS: INTEGER;
TMP: INTEGER;
BEGIN
NEG:=FALSE;
IF I<0 THEN BEGIN
LEN:=LEN-1;
NEG:=TRUE;
I:=-I;
END;
DIGS:=0;
TMP:=I;
POW10:=1;
REPEAT
TMP:=TMP DIV 10;
POW10:=POW10*10;
DIGS:=DIGS+1;
UNTIL TMP=0;
FOR TMP:=LEN DOWNTO DIGS DO BEGIN
WRITE(' ');
END;
IF NEG THEN BEGIN
WRITE('-');
END;
REPEAT
POW10:=POW10 DIV 10;
TMP:=I DIV POW10;
WRITE(CHR(TMP+ORD('0')));
I:=I MOD POW10;
UNTIL POW10=1;
END;
(**********************************************************************)
PROCEDURE INITARY(VAR ARY: SORTARY);
CONST
A= 54321;
C= 0;
M= 59999;
VAR
I: SORTINDX;
RAND: INTEGER;
BEGIN
RAND:=12345;
FOR I:=1 TO MAXINDX DO BEGIN
RAND:=((A*RAND+C) MOD M);
ARY[I]:=RAND;
END;
END;
(**********************************************************************)
PROCEDURE PRTARY(VAR A: SORTARY);
VAR
I: SORTINDX;
BEGIN
FOR I:=1 TO MAXSORT DO BEGIN
WRTINT(A[I],12);
WRITELN(OUTPUT);
END;
WRITELN(OUTPUT);
END;
(**********************************************************************)
PROCEDURE SORT(VAR A: SORTARY);
LABEL 1,2,3,4,5,6;
VAR
P,
L,
R,
I,
J,
T: INTEGER;
TMP,
V: SORTITEM;
STACK: ARRAY [0 .. MAXSTACK] OF INTEGER;
BEGIN
A[0]:=-INFINITY;
A[MAXSORT+1]:=INFINITY;
P:=0; L:=1; R:=MAXSORT;
1:
I:=L; J:=R+1; V:=A[L];
WHILE I<J DO BEGIN
I:=I+1; WHILE A[I]<V DO I:=I+1;
J:=J-1; WHILE A[J]>V DO J:=J-1;
TMP:=A[J];
A[J]:=A[I];
A[I]:=TMP;
END;
TMP:=A[J];
A[J]:=A[L];
A[L]:=A[I];
A[I]:=TMP;
IF (R-J)>(J-L) THEN GOTO 3;
IF (J-L)<=M THEN GOTO 5;
IF (R-J)<=M THEN GOTO 4;
P:=P+2;
STACK[P]:=L;
STACK[P+1]:=J-1;
2:
L:=J+1;
GOTO 1;
3:
IF (R-J)<=M THEN GOTO 5;
IF (J-L)<=M THEN GOTO 2;
P:=P+2;
STACK[P]:=J+1;
STACK[P+1]:=R;
4:
R:=J-1;
GOTO 1;
5:
L:=STACK[P];
R:=STACK[P+1];
P:=P-2;
IF P>=0 THEN GOTO 1;
6:
FOR I:=2 TO MAXSORT DO BEGIN
V:=A[I];
J:=I-1;
WHILE A[J]>V DO BEGIN
A[J+1]:=A[J];
J:=J-1;
END;
A[J+1]:=V;
END;
END;
(**********************************************************************)
BEGIN
INITARY(A);
(*PRTARY(A);*)
SORT(A);
PRTARY(A);
END.
(**********************************************************************)